home *** CD-ROM | disk | FTP | other *** search
/ Your Choice 1 / your choice.zip / your choice / PRGMMING / VISIONIX / VFONTU.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-28  |  39KB  |  1,953 lines
  1. {
  2.  ════════════════════════════════════════════════════════════════════════════
  3.  
  4.  Visionix EGA/VGA Font Manipulation Unit (VFONT)
  5.    Version 0.8
  6.  Copyright 1991,92,93 Visionix
  7.  ALL RIGHTS RESERVED
  8.  
  9.  ────────────────────────────────────────────────────────────────────────────
  10.  
  11.  Revision history in reverse chronological order:
  12.  
  13.  Initials  Date      Comment
  14.  ────────  ────────  ────────────────────────────────────────────────────────
  15.  
  16.  jrt       11/02/93  Brought CGAPixelMap stuff from VBIOS,
  17.                      made use VStringu.
  18.  
  19.  jrt       05/23/93  Maded VFontPut work in DPMI protected mode.
  20.  
  21.  mep       05/20/93  Added many new functions, such as font sets, textfile
  22.                      font load/save, image file load/save, resolution scaling,
  23.                      and alternate font sets.
  24.  
  25.  lpg       03/15/93  Added Source Documentation
  26.  
  27.  mep       02/11/93  Cleaned up code for beta release
  28.  
  29.  jrt       02/08/93  Sync with beta 0.12 release
  30.  
  31.  jrt       12/15/92  Updated to work in protected mode for BP 7.0
  32.  
  33.  jrt       12/07/92  Sync with beta 0.11 release
  34.  
  35.  jrt       11/25/92  Moved VFontVGAWidthSet to here from VCRT.
  36.                      Wrote template for VFontDefaultLoad.
  37.                      Rename VPutFont/VGetFont to VFontPut/VFontGet.
  38.  
  39.  jrt       11/21/92  Sync with beta 0.08
  40.  
  41.  jrt       09/01/92  First logged revision.
  42.  
  43.  ════════════════════════════════════════════════════════════════════════════
  44. }
  45.  
  46. (*-
  47.  
  48. [TEXT]
  49.  
  50. <Overview>
  51.  
  52. The VFONTu unit implements functions to create and manage new text-mode
  53. character sets.
  54.  
  55. The documentation for this unit will be enhanced in the next release.
  56.  
  57. <Interface>
  58.  
  59. -*)
  60.  
  61.  
  62.  
  63. Unit VFontu;
  64.  
  65. Interface
  66.  
  67. Uses
  68.  
  69.   DOS,
  70.   VDOSHu,
  71. {$IFNDEF OS2}
  72.   VDPMIu,
  73.   VEQUIPu,
  74. {$ELSE}
  75.   VVIOi,
  76. {$ENDIF}
  77. {$IFDEF DEBUG}
  78.   VDebugu,
  79. {$ENDIF}
  80.   VTYPESu,
  81.   VStringu,
  82.   VGENu;
  83.  
  84. {────────────────────────────────────────────────────────────────────────────}
  85.  
  86. Const
  87.  
  88.   {------------}
  89.   { Font Types }
  90.   {------------}
  91.  
  92.   Font_Int1F    = 0; { INT $1F font }
  93.   Font_Int43F   = 1; { INT $43 font }
  94.   Font_EGA_8x14 = 2; { ROM 8x14 character font }
  95.   Font_VGA_8x8  = 3; { ROM 8x8 double dot font }
  96.   Font_DDH_8x8  = 4; { ROM 8x8 double dot high font }
  97.   Font_AA_9x14  = 5; { ROM 9x14 alpha alternate font }
  98.   Font_VGA_8x16 = 6; { ROM 8x16 font }
  99.   Font_A_9x16   = 7; { ROM 9x16 alternate font }
  100.  
  101. Type
  102.  
  103.   TFontSet = RECORD
  104.  
  105.     ScanLines : BYTE;        { Number of elements per font }
  106.     Width     : BYTE;        { Number of bits per element }
  107.     FontPtr   : POINTER;     { Location of font table on vidcard }
  108.  
  109.     Table     : POINTER;     { Internal user font table }
  110.  
  111.   END;
  112.  
  113.   PFontSet = ^TFontSet;
  114.  
  115.  
  116.   TCharPixelMap = Array[0..7] of BYTE;
  117.   PCharPixelMap = ^TCharPixelMap;
  118.  
  119.   {----}
  120.  
  121.  
  122. {────────────────────────────────────────────────────────────────────────────}
  123.  
  124. {--------------------------------}
  125. { Basic table to/from video card }
  126. {--------------------------------}
  127.  
  128. Procedure VFontGet(               FontType       : BYTE;
  129.                               Var ScanLines      : BYTE;
  130.                               Var Table          : POINTER      );
  131.  
  132. Procedure VFontPut(               Index          : WORD;
  133.                                   Count          : WORD;
  134.                                   ScanLines      : BYTE;
  135.                                   Table          : POINTER      );
  136.  
  137. {-----------}
  138. { Font Sets }
  139. {-----------}
  140.  
  141. Procedure VFontSetNew(        Var FontSet        : TFontSet;
  142.                                   Width          : BYTE;
  143.                                   ScanLines      : BYTE         );
  144.  
  145. Procedure VFontSetGet(            FontType       : BYTE;
  146.                               Var FontSet        : TFontSet     );
  147.  
  148. Procedure VFontSetPut(            FontSet        : TFontSet     );
  149.  
  150. Procedure VFontSetDispose(        FontSet        : TFontSet     );
  151.  
  152. Function  VFontSetIndex(          FontSet        : TFontSet;
  153.                                   ASCII          : BYTE         ) : LONGINT;
  154.  
  155. Function  VFontSetIndexPtr(       FontSet        : TFontSet;
  156.                                   ASCII          : BYTE         ) : POINTER;
  157.  
  158. {------}
  159. { File }
  160. {------}
  161.  
  162. Procedure VFontGetImage(          Filename       : PathStr;
  163.                               Var FontSet        : TFontSet     );
  164.  
  165. Procedure VFontGetNewImage(       Filename       : PathStr;
  166.                               Var FontSet        : TFontSet     );
  167.  
  168. Procedure VFontPutImage(          Filename       : PathStr;
  169.                                   FontSet        : TFontSet     );
  170.  
  171. Procedure VFontGetText(           Filename       : PathStr;
  172.                                   StartChar      : BYTE;
  173.                                   EndChar        : BYTE;
  174.                                   OnBitChar      : CHAR;
  175.                                   OffBitChar     : CHAR;
  176.                               Var FontSet        : TFontSet     );
  177.  
  178. Procedure VFontPutText(           Filename       : PathStr;
  179.                                   StartChar      : BYTE;
  180.                                   EndChar        : BYTE;
  181.                                   OnBitChar      : CHAR;
  182.                                   OffBitChar     : CHAR;
  183.                                   FontSet        : TFontSet     );
  184.  
  185. Procedure VFontMakePascal(        Filename       : PathStr;
  186.                                   FontSet        : TFontSet;
  187.                                   StartChar      : BYTE;
  188.                                   EndChar        : WORD         );
  189.  
  190. {-----------}
  191. { ROM Fonts }
  192. {-----------}
  193.  
  194. Procedure VFontROM8x16Load;
  195.  
  196. Procedure VFontROM8x14Load;
  197.  
  198. Procedure VFontROM8x8Load;
  199.  
  200. Procedure VFontDefaultLoad;
  201.  
  202. Procedure VFontVGAWidthSet(       CharWidth      : BYTE         );
  203.  
  204. {--------------}
  205. { Miscellanous }
  206. {--------------}
  207.  
  208. Procedure VFontSetScale(          Source         : TFontSet;
  209.                                   StartChar      : BYTE;
  210.                                   EndChar        : WORD;
  211.                               Var Target         : TFontSet     );
  212.  
  213. Procedure VFontAltPut(            Index          : BYTE;
  214.                                   Count          : WORD;
  215.                                   ScanLines      : BYTE;
  216.                                   Table          : POINTER      );
  217.  
  218. Procedure VFontAltSetPut(         FontSet        : TFontSet     );
  219.  
  220.  
  221.  
  222. Function  GetCGAPixelMap( Ch : CHAR ) : PCharPixelMap;
  223.  
  224. {────────────────────────────────────────────────────────────────────────────}
  225.  
  226. Implementation
  227.  
  228. Const
  229.  
  230.   BPCParam : STRING[18] = 'SCANLINES';
  231.  
  232. {────────────────────────────────────────────────────────────────────────────}
  233.  
  234. (*-
  235.  
  236. [FUNCTION]
  237.  
  238. Procedure VFontGet(               FontType       : BYTE;
  239.                               Var ScanLines      : BYTE;
  240.                               Var Table          : POINTER      );
  241.  
  242. [PARAMETERS]
  243.  
  244. FontType    Requested font information for various modes (see interface).
  245.  
  246.               Font_Int1F    = 0; { INT $1F font }
  247.               Font_Int43F   = 1; { INT $43 font }
  248.               Font_EGA_8x14 = 2; { ROM 8x14 character font }
  249.               Font_VGA_8x8  = 3; { ROM 8x8 double dot font }
  250.               Font_DDH_8x8  = 4; { ROM 8x8 double dot high font }
  251.               Font_AA_9x14  = 5; { ROM 9x14 alpha alternate font }
  252.               Font_VGA_8x16 = 6; { ROM 8x16 font }
  253.               Font_A_9x16   = 7; { ROM 9x16 alternate font }
  254.  
  255.  
  256. [RETURNS]
  257.  
  258. ScanLines   Lines of on-screen font (not the requested font!).
  259. Table       Location of requested font table.
  260.  
  261. [DESCRIPTION]
  262.  
  263. Requests font information for specified font modes.
  264.  
  265. [SEE-ALSO]
  266.  
  267. VFontPut
  268.  
  269. [EXAMPLE]
  270.  
  271. Uses CRT;
  272. Var
  273.   ScanLines : BYTE;
  274.   Table     : POINTER;
  275.  
  276. BEGIN
  277.   TextMode(co80); { make sure in 80x25 mode }
  278.   VFontGet(Font_VGA_8x16, Scanlines, Table);
  279.  
  280.   { Scanlines = 16 and Table points to ROM 8x16 fonts }
  281. END;
  282.  
  283. -*)
  284.  
  285. Procedure VFontGet(               FontType       : BYTE;
  286.                               Var ScanLines      : BYTE;
  287.                               Var Table          : POINTER      );
  288.  
  289. {$IFNDEF OS2}
  290.  
  291. Var
  292.  
  293.   P   : POINTER;
  294.   BPC : BYTE;
  295.  
  296. BEGIN
  297.  
  298.   ASM
  299.  
  300.     MOV AH, 11h
  301.     MOV AL, 30h
  302.     MOV BH, FontType
  303.     PUSH BP
  304.  
  305.     INT 10h
  306.     MOV DX, BP
  307.     POP BP
  308.  
  309.     MOV Byte( BPC ), CL
  310.     MOV Word( P   ), DX
  311.     MOV Word( P+2 ), ES
  312.  
  313.   END;
  314.  
  315.   Table := P;
  316.   ScanLines:=BPC;
  317.  
  318. END;
  319.  
  320. {$ELSE}
  321.  
  322. BEGIN
  323.  
  324.  
  325.  
  326.   {!^!}
  327.  
  328. END;
  329.  
  330. {$ENDIF}
  331.  
  332.  
  333. {────────────────────────────────────────────────────────────────────────────}
  334.  
  335. (*-
  336.  
  337. [FUNCTION]
  338.  
  339. Procedure VFontPut(               Index          : WORD;
  340.                                   Count          : WORD;
  341.                                   ScanLines      : BYTE;
  342.                                   Table          : POINTER      );
  343.  
  344. [PARAMETERS]
  345.  
  346. Index       ASCII character to start font update at
  347. Count       number of characters to update
  348. ScanLines   Scanlines in new font table.
  349. Table       Pointer to new font table.
  350.  
  351. [RETURNS]
  352.  
  353. <none>
  354.  
  355. [DESCRIPTION]
  356.  
  357. Redefines the EGA/VGA font bitmap, starting at character "index" and
  358. going for "count" characters.  "ScanLines" should the number of bytes
  359. per character in the new font table (since each character is always
  360. 8-bits or pixels wide), and "table" should be a pointer to the
  361. new font table information.
  362.  
  363. [SEE-ALSO]
  364.  
  365. VFontGet
  366.  
  367. [EXAMPLE]
  368.  
  369. Const
  370.  
  371.   Arrow : Array[0..15] of BYTE =
  372.     ( $00, $00, $FC, $1C, $3C, $74, $E4, $E4,
  373.       $74, $3C, $1C, $FC, $00, $00, $00, $00      );
  374.  
  375. BEGIN
  376.  
  377.   VFontPut( 181, 1, 16, @Arrow );
  378.  
  379.   { Makes ASCII #181 an arrow }
  380.  
  381. END;
  382.  
  383. -*)
  384.  
  385. (*
  386. procedure showfont( fb : Pbytearray0; count : word );
  387.  
  388. var
  389.  
  390.   z,col,row : integer;
  391.   S         : STRING;
  392.  
  393. begin
  394.  
  395.   for z:=1 to count do
  396.   begin
  397.  
  398.     Debugwriteln('');
  399.     debugwriteln('Character '+IntToStr(Z-1) );
  400.     debugwriteln('');
  401.  
  402.     for row := 1 to 16 do
  403.     begin
  404.  
  405.       S:='';
  406.  
  407.       for col := 7 downto 0 do
  408.       begin
  409.  
  410.        if FB^[ (Pred(z)*16) + (Pred(row)) ] and (1 SHL COL) > 0 Then
  411.          S := S + '#'
  412.        Else
  413.          S := S + '.';
  414.  
  415.       end;
  416.  
  417.       DebugWriteLn( S );
  418.       WriteLn( S );
  419.  
  420.     end;
  421.  
  422.   end;
  423.  
  424. end;
  425. *)
  426.  
  427. Procedure VFontPut(               Index          : WORD;
  428.                                   Count          : WORD;
  429.                                   ScanLines      : BYTE;
  430.                                   Table          : POINTER      );
  431.  
  432.  
  433. {$IFNDEF OS2}
  434.  
  435. Var
  436.  
  437.   P : POINTER;
  438.  
  439.   R : REGISTERS;
  440.  
  441. BEGIN
  442.  
  443.   P := Table;
  444.  
  445.   R.AH := $11;
  446.   R.AL := $0;
  447.   R.BH := ScanLines;
  448.   R.BL := 0;
  449.   R.CX := Count;
  450.   R.DX := Index;
  451.   R.ES := Seg( Table^ );
  452.   R.BP := Ofs( Table^ );
  453.  
  454.   RefBuffIntr( rb_ESBP+rb_Down,
  455.                 $10,
  456.                 R,
  457.                 Table,
  458.                 ScanLines*Count );
  459.  
  460.  
  461. END;
  462.  
  463. {$ELSE}
  464.  
  465. Var
  466.  
  467.   VFI      : TVioFontInfo;
  468.   FB       : PByteArray0;
  469.   Err      : WORD;
  470.   CharSize : WORD;
  471.   FontOfs  : WORD;
  472.  
  473.  
  474. BEGIN
  475.  
  476.   {$IFDEF DEBUG}
  477.     DebugWriteLn('    In VFontPut');
  478.     DebugWriteLn('    Allocating a font buffer');
  479.   {$ENDIF}
  480.  
  481.   { allocate a font buffer }
  482.  
  483.   New( FB );
  484.  
  485.   {$IFDEF DEBUG}
  486.     DebugWriteLn('    Settings up the font into struct');
  487.   {$ENDIF}
  488.  
  489.   { setup the Font info struct }
  490.  
  491.   VFI.CB       := 14;
  492.   VFI.TheType  := VGFI_GETCURFONT;
  493.   VFI.CellRows := 0;
  494.   VFI.CellCols := 0;
  495.   VFI.FontData := FB;
  496.   VFI.CBData   := SizeOf( FB^ );
  497.  
  498.   { get the full font }
  499.  
  500.   {$IFDEF DEBUG}
  501.     DebugWriteLn('    Cbdata = '+IntTostr(Vfi.cbdata) );
  502.     DebugWriteLn('    Get the full font (VioGetFont)');
  503.   {$ENDIF}
  504.  
  505.   Err := VioGetFont( @VFI, 0 );
  506.  
  507.   {$IFDEF DEBUG}
  508.     DebugWriteLn('      (VioGetFont returned '+IntToStr(err)+')' );
  509.   {$ENDIF}
  510.  
  511.  
  512.   IF Err=0 Then
  513.   BEGIN
  514.  
  515.  
  516.     {$IFDEF DEBUG}
  517.       DebugWriteLn('      VFI.CellRows = '+IntToStr(VFI.CellRows) );
  518.       DebugWriteLn('      VFI.CellCols = '+IntToStr(VFI.CellCols) );
  519.       DebugWriteLn('      VFI.CBData   = '+IntToStr(VFI.CBData  ) );
  520.     {$ENDIF}
  521.  
  522.  
  523.     { Validate that the incoming char size and }
  524.     { the actual font size match.              }
  525.  
  526.     If (VFI.CellRows=ScanLines) Then
  527.     BEGIN
  528.  
  529.       CharSize  := VFI.CellRows;
  530.  
  531.       FontOfs  := Index * CharSize;
  532.  
  533.       {$IFDEF DEBUG}
  534.         DebugWriteLn('      Charsize = '+IntToStr(charsize) );
  535.         DebugWriteLn('      fontofs  = '+IntToStr(fontofs)  );
  536.       {$ENDIF}
  537.  
  538.  
  539.       { copy our changes over }
  540.  
  541.       Move( Table^, FB^[FontOfs], Count * CharSize );
  542.  
  543.       { set the full font }
  544.  
  545.       VFI.TheType := 0;
  546.  
  547.       {$IFDEF DEBUG}
  548.         DebugWriteLn('      Calling VioSetFont' );
  549.       {$ENDIF}
  550.  
  551.       Err := VioSetFont( @VFI, 0 );
  552.  
  553.       {$IFDEF DEBUG}
  554.         DebugWriteLn('      (VioSetFont returned '+IntToStr(err)+')' );
  555.       {$ENDIF}
  556.  
  557.       { showfont( fb, 256  ); }
  558.  
  559.     END; { if font sizes match }
  560.  
  561.   END; { if err=0 }
  562.  
  563. END;
  564.  
  565. {$ENDIF}
  566.  
  567. {────────────────────────────────────────────────────────────────────────────}
  568.  
  569.  
  570. Function  VFontNewTable(          ScanLines      : BYTE         ) : POINTER;
  571.  
  572. Var
  573.  
  574.   P : POINTER;
  575.  
  576. BEGIN
  577.  
  578.   If MaxAvail < (ScanLines * 256) Then
  579.     P := NIL
  580.   Else
  581.   BEGIN
  582.  
  583.     GetMem(P, ScanLines * 256);
  584.     FillChar(P^, ScanLines * 256, 0);
  585.  
  586.   END;
  587.  
  588.   VFontNewTable := P;
  589.  
  590. END;
  591.  
  592. {────────────────────────────────────────────────────────────────────────────}
  593.  
  594. Procedure VFontDisposeTable(  Var Table          : POINTER;
  595.                                   ScanLines      : BYTE           );
  596.  
  597. BEGIN
  598.  
  599.   If Table = NIL Then
  600.     Exit;
  601.  
  602.   FreeMem( Table, ScanLines * 256 );
  603.   Table := NIL;
  604.  
  605. END;
  606.  
  607. {────────────────────────────────────────────────────────────────────────────}
  608.  
  609. (*-
  610.  
  611. [FUNCTION]
  612.  
  613. Procedure VFontSetNew(        Var FontSet        : TFontSet;
  614.                                   Width          : BYTE;
  615.                                   ScanLines      : BYTE         );
  616.  
  617. [PARAMETERS]
  618.  
  619. FontSet     Fontlist information record.
  620. Width       Width of each font (8 bits normally).
  621. ScanLines   Number of lines (rows) per font (1..16).
  622.  
  623. [RETURNS]
  624.  
  625. <None>
  626.  
  627. [DESCRIPTION]
  628.  
  629. Creates a new font set (table).  This must be called before any calls to
  630. the FontSet procedures.
  631.  
  632. Note that you do not need to call this if you are using VFontSetGet, because
  633. that procedure calls this automatically.
  634.  
  635. Also remember to always VFontSetDispose your FontSet after this procedure
  636. has been used.
  637.  
  638. [SEE-ALSO]
  639.  
  640. VFontSetDispose
  641. VFontSetGet
  642.  
  643. [EXAMPLE]
  644.  
  645. Var fs : TFontSet;
  646.  
  647. BEGIN
  648.   VFontSetNew( fs, 8, 16 );
  649.  
  650.   { table created for 8x16 fonts.. now, do your routines.. }
  651.  
  652.   VFontSetDispose( fs );
  653. END;
  654.  
  655. -*)
  656.  
  657. Procedure VFontSetNew(        Var FontSet        : TFontSet;
  658.                                   Width          : BYTE;
  659.                                   ScanLines      : BYTE         );
  660.  
  661. BEGIN
  662.  
  663.   FontSet.Width     := Width;
  664.   FontSet.ScanLines := Scanlines;
  665.   FontSet.Table     := VFontNewTable( ScanLines );
  666.  
  667. END;
  668.  
  669. {────────────────────────────────────────────────────────────────────────────}
  670.  
  671. (*-
  672.  
  673. [FUNCTION]
  674.  
  675. Procedure VFontSetGet(            FontType       : BYTE;
  676.                               Var FontSet        : TFontSet     );
  677.  
  678. [PARAMETERS]
  679.  
  680. FontType    Requested font information for various modes (see interface).
  681.  
  682. [RETURNS]
  683.  
  684. FontSet     Fontlist information record.
  685.  
  686. [DESCRIPTION]
  687.  
  688. Initializes a FontSet with a ROM Font set.  This creates an internal
  689. table with the fontlist.  Do not call VFontSetNew if this is being used.
  690.  
  691. Also, remember to use VFontSetDispose whenever this procedure is used.
  692.  
  693. [SEE-ALSO]
  694.  
  695. VFontSetNew
  696. VFontSetPut
  697.  
  698. [EXAMPLE]
  699.  
  700. Var fs8 : TFontSet;
  701.  
  702. BEGIN
  703.   TextMode(co80+font8x8);
  704.   VFontROM8x8Load;
  705.   VFontSetGet( fs8, Font_VGA_8x8 );
  706.  
  707.   { Your fontset now has the ROM 8x8 set loaded.. }
  708.  
  709.   VFontSetDispose( fs8 );
  710. END;
  711.  
  712. -*)
  713.  
  714. Procedure VFontSetGet(            FontType       : BYTE;
  715.                               Var FontSet        : TFontSet     );
  716.  
  717. BEGIN
  718.  
  719.   FillChar( FontSet, SizeOf(TFontSet), 0 );
  720.  
  721.   With FontSet Do
  722.   BEGIN
  723.  
  724.     Width := 8;
  725.     VFontGet( FontType, ScanLines, FontPtr );
  726.     Table := VFontNewTable( ScanLines );
  727.     Move( FontPtr^, Table^, ScanLines * 256 );
  728.  
  729.   END;
  730.  
  731. END;
  732.  
  733. {────────────────────────────────────────────────────────────────────────────}
  734.  
  735. (*-
  736.  
  737. [FUNCTION]
  738.  
  739. Procedure VFontSetPut(            FontSet        : TFontSet     );
  740.  
  741. [PARAMETERS]
  742.  
  743. FontSet     Fontlist information record.
  744.  
  745. [RETURNS]
  746.  
  747. <none>
  748.  
  749. [DESCRIPTION]
  750.  
  751. Sends the whole set within FontSet to the video card font generator.
  752. Typesetting is automatically allowed for whole set.
  753.  
  754. [SEE-ALSO]
  755.  
  756. VFontSetGet
  757.  
  758. [EXAMPLE]
  759.  
  760. Var fs16 : TFontSet;
  761.  
  762. BEGIN
  763.   TextMode(co80);
  764.   VFontROM8x16Load;
  765.   VFontSetGet(Font_VGA_8x16, fs16);
  766.  
  767.   { ..here you can do whatever (ie. modifing the loaded table).. }
  768.  
  769.   VFontSetPut(fs16);
  770. END;
  771.  
  772. -*)
  773.  
  774. Procedure VFontSetPut(            FontSet        : TFontSet     );
  775.  
  776. BEGIN
  777.  
  778.   VFontPut( 0, 256, FontSet.ScanLines, Addr(FontSet.Table^) );
  779.  
  780. END;
  781.  
  782. {────────────────────────────────────────────────────────────────────────────}
  783.  
  784. (*-
  785.  
  786. [FUNCTION]
  787.  
  788. Procedure VFontSetDispose(        FontSet        : TFontSet     );
  789.  
  790. [PARAMETERS]
  791.  
  792. FontSet     Fontlist information record.
  793.  
  794. [RETURNS]
  795.  
  796. <none>
  797.  
  798. [DESCRIPTION]
  799.  
  800. Disposes a font set (table).  This must be called once you are done with
  801. your FontSet calls to reclaim allocated memory.
  802.  
  803. Also remember to always VFontSetNew your FontSet before this procedure is
  804. used!
  805.  
  806. [SEE-ALSO]
  807.  
  808. VFontSetNew
  809.  
  810. [EXAMPLE]
  811.  
  812. Var fs : TFontSet;
  813.  
  814. BEGIN
  815.   TextMode(co80);
  816.   VFontROM8x16Load;
  817.   VFontSetGet( fs, Font_VGA_8x16 );
  818.  
  819.   { Your fontset now has the ROM 8x16 set loaded.. }
  820.  
  821.   VFontSetDispose( fs );
  822. END;
  823.  
  824. -*)
  825.  
  826. Procedure VFontSetDispose(        FontSet        : TFontSet     );
  827.  
  828. BEGIN
  829.  
  830.   VFontDisposeTable( FontSet.Table, FontSet.ScanLines );
  831.  
  832. END;
  833.  
  834. {────────────────────────────────────────────────────────────────────────────}
  835.  
  836. (*-
  837.  
  838. [FUNCTION]
  839.  
  840. Function  VFontSetIndex(          FontSet        : TFontSet;
  841.                                   ASCII          : BYTE         ) : LONGINT;
  842.  
  843. [PARAMETERS]
  844.  
  845. FontSet     Fontlist information record.
  846. ASCII       ASCII character number in table (0..255).
  847.  
  848. [RETURNS]
  849.  
  850. Index into table.
  851.  
  852. [DESCRIPTION]
  853.  
  854. Number of bytes indexed into fontset where the bitmap is located.
  855.  
  856. [SEE-ALSO]
  857.  
  858. VFontSetIndexPtr
  859.  
  860. [EXAMPLE]
  861.  
  862. -*)
  863.  
  864. Function  VFontSetIndex(          FontSet        : TFontSet;
  865.                                   ASCII          : BYTE         ) : LONGINT;
  866.  
  867. BEGIN
  868.  
  869.   VFontSetIndex := FontSet.ScanLines * ASCII;  { !^! Width not used. }
  870.  
  871. END;
  872.  
  873. {────────────────────────────────────────────────────────────────────────────}
  874.  
  875. (*-
  876.  
  877. [FUNCTION]
  878.  
  879. Function  VFontSetIndexPtr(       FontSet        : TFontSet;
  880.                                   ASCII          : BYTE         ) : POINTER;
  881.  
  882. [PARAMETERS]
  883.  
  884. FontSet     Fontlist information record.
  885. ASCII       ASCII character number in table (0..255).
  886.  
  887. [RETURNS]
  888.  
  889. Pointer index into table.
  890.  
  891. [DESCRIPTION]
  892.  
  893. Pointer to the index into fontset where the bitmap is located.
  894.  
  895. [SEE-ALSO]
  896.  
  897. VFontSetIndex
  898.  
  899. [EXAMPLE]
  900.  
  901. -*)
  902.  
  903. Function  VFontSetIndexPtr(       FontSet        : TFontSet;
  904.                                   ASCII          : BYTE         ) : POINTER;
  905.  
  906. BEGIN
  907.  
  908.   VFontSetIndexPtr := PtrAdd( FontSet.Table, VFontSetIndex(FontSet, ASCII) );
  909.  
  910. END;
  911.  
  912. {────────────────────────────────────────────────────────────────────────────}
  913.  
  914. (*-
  915.  
  916. [FUNCTION]
  917.  
  918. Procedure VFontGetImage(          Filename       : PathStr;
  919.                               Var FontSet        : TFontSet     );
  920.  
  921. [PARAMETERS]
  922.  
  923. Filename    A valid filename to a font file.
  924.  
  925. [RETURNS]
  926.  
  927. FontSet     Fontlist information record.
  928.  
  929. [DESCRIPTION]
  930.  
  931. Loads an image file from disk into a fontset.  You must have allocated a new
  932. FontSet BEFORE this procedure is called.  This procedure is good for
  933. reloading already allocated FontSets.  If you want to allocate a new FontSet
  934. from an image file, use VFontGetNewImage.
  935.  
  936. [SEE-ALSO]
  937.  
  938. VFontGetNewImage
  939.  
  940. [EXAMPLE]
  941.  
  942. -*)
  943.  
  944. Procedure VFontGetImage(          Filename       : PathStr;
  945.                               Var FontSet        : TFontSet     );
  946.  
  947. Var
  948.  
  949.   FontF : FILE;
  950.  
  951. BEGIN
  952.  
  953.   If NOT FileExist(Filename) Then
  954.     Exit;
  955.  
  956.   Assign(FontF, Filename);
  957.   Reset(FontF, 1);
  958.   BlockRead(FontF, FontSet.Table^, FontSet.ScanLines * 256);
  959.   Close(FontF);
  960.  
  961. END;
  962.  
  963. {────────────────────────────────────────────────────────────────────────────}
  964.  
  965. (*-
  966.  
  967. [FUNCTION]
  968.  
  969. Procedure VFontGetNewImage(       Filename       : PathStr;
  970.                               Var FontSet        : TFontSet     );
  971.  
  972. [PARAMETERS]
  973.  
  974. Filename    A valid filename to a font file.
  975.  
  976. [RETURNS]
  977.  
  978. FontSet     Fontlist information record.
  979.  
  980. [DESCRIPTION]
  981.  
  982. Loads an image file from disk into a fontset.  This procedure allocates a
  983. new table automatically - be careful not to allocate a fontset more than
  984. once (ie. calling this procedure more than once per FontSet).
  985.  
  986. Remember, when using this procedure, to use VFontSetDispose.
  987.  
  988. [SEE-ALSO]
  989.  
  990. VFontGetImage
  991. VFontSetDispose
  992.  
  993. [EXAMPLE]
  994.  
  995. -*)
  996.  
  997. Procedure VFontGetNewImage(       Filename       : PathStr;
  998.                               Var FontSet        : TFontSet     );
  999.  
  1000. Var
  1001.  
  1002.   FontF : FILE;
  1003.  
  1004. BEGIN
  1005.  
  1006.   If NOT FileExist(Filename) Then
  1007.     Exit;
  1008.  
  1009.   Assign(FontF, Filename);
  1010.   Reset(FontF, 1);
  1011.  
  1012.   FontSet.ScanLines := FileSize(FontF) DIV 256;
  1013.  
  1014.   VFontSetNew( FontSet, 8, FontSet.ScanLines );
  1015.  
  1016.   BlockRead(FontF, FontSet.Table^, FontSet.ScanLines * 256);
  1017.   Close(FontF);
  1018.  
  1019. END;
  1020.  
  1021. {────────────────────────────────────────────────────────────────────────────}
  1022.  
  1023. (*-
  1024.  
  1025. [FUNCTION]
  1026.  
  1027. Procedure VFontPutImage(          Filename       : PathStr;
  1028.                                   FontSet        : TFontSet     );
  1029.  
  1030. [PARAMETERS]
  1031.  
  1032. Filename    A valid path and filename to create.
  1033. FontSet     Fontlist information record.
  1034.  
  1035. [RETURNS]
  1036.  
  1037. <none>
  1038.  
  1039. [DESCRIPTION]
  1040.  
  1041. Creates an image file using the specified FontSet.
  1042.  
  1043. [SEE-ALSO]
  1044.  
  1045. VFontGetImage
  1046. VFontGetNewImage
  1047.  
  1048. [EXAMPLE]
  1049.  
  1050. -*)
  1051.  
  1052. Procedure VFontPutImage(          Filename       : PathStr;
  1053.                                   FontSet        : TFontSet     );
  1054.  
  1055. Var
  1056.  
  1057.   FontF : FILE;
  1058.  
  1059. BEGIN
  1060.  
  1061.   If NOT FileExist(Filename) Then
  1062.     Exit;
  1063.  
  1064.   Assign(FontF, Filename);
  1065.   Rewrite(FontF, 1);
  1066.   BlockWrite(FontF, FontSet.Table^, FontSet.ScanLines * 256);
  1067.   Close(FontF);
  1068.  
  1069. END;
  1070.  
  1071. {────────────────────────────────────────────────────────────────────────────}
  1072.  
  1073. (*-
  1074.  
  1075. [FUNCTION]
  1076.  
  1077. Procedure VFontGetText(           Filename       : PathStr;
  1078.                                   StartChar      : BYTE;
  1079.                                   EndChar        : BYTE;
  1080.                                   OnBitChar      : CHAR;
  1081.                                   OffBitChar     : CHAR;
  1082.                               Var FontSet        : TFontSet     );
  1083.  
  1084. [PARAMETERS]
  1085.  
  1086. Filename    A valid path and filename to create.
  1087. StartChar   Starting character to "overwrite" (0..255).
  1088. EndChar     Ending character to "overwrite" (0..255).
  1089. OnBitChar   Character in textfile to consider as an On-Bit in a font.
  1090. OffBitChar  Character in textfile to consider as an Off-Bit in a font.
  1091.  
  1092. [RETURNS]
  1093.  
  1094. FontSet     Fontlist information record.
  1095.  
  1096. [DESCRIPTION]
  1097.  
  1098. Loads a textfile into the specified range of the FontSet.  Loading will
  1099. overwrite any fonts within that region.
  1100.  
  1101. IMPORTANT: Even though the StartChar and EndChar might not include the whole
  1102. range of the FontSet, reading fonts will ALWAYS begin at the beginning of the
  1103. textfile - note that the first font in the text file might not be the
  1104. font you want as the "StartChar" in your FontSet.
  1105.  
  1106. [SEE-ALSO]
  1107.  
  1108. VFontPutText
  1109.  
  1110. [EXAMPLE]
  1111.  
  1112. -*)
  1113.  
  1114. Procedure VFontGetText(           Filename       : PathStr;
  1115.                                   StartChar      : BYTE;
  1116.                                   EndChar        : BYTE;
  1117.                                   OnBitChar      : CHAR;
  1118.                                   OffBitChar     : CHAR;
  1119.                               Var FontSet        : TFontSet     );
  1120.  
  1121. Var
  1122.  
  1123.   F       : FILE;
  1124.   Buf     : PCharDarray0;
  1125.   BufSize : LONGINT;
  1126.   BufPos  : LONGINT;
  1127.  
  1128.   BPCPos  : LONGINT;
  1129.  
  1130.   S       : STRING;
  1131.   P       : POINTER;
  1132.   Param   : STRING[2];
  1133.  
  1134.   OnFont  : WORD;
  1135.   OnLine  : BYTE;
  1136.   OnBit   : BYTE;
  1137.  
  1138.   {────────────────────────────────────────────────────────────────────────}
  1139.  
  1140.   Procedure IncFontPos;
  1141.   BEGIN
  1142.     If (OnBit > 0) Then
  1143.       Dec(OnBit)
  1144.     Else
  1145.     BEGIN
  1146.       OnBit := Pred(FontSet.Width);
  1147.       If (OnLine < FontSet.ScanLines) Then
  1148.         Inc(OnLine)
  1149.       Else
  1150.       BEGIN
  1151.         OnLine := 1;
  1152.         Inc(OnFont);
  1153.       END;
  1154.     END;
  1155.   END;
  1156.  
  1157.   {────────────────────────────────────────────────────────────────────────}
  1158.  
  1159. BEGIN
  1160.  
  1161.   {-----------------------------------}
  1162.   { Check for reserved bit characters }
  1163.   {-----------------------------------}
  1164.  
  1165.   If ( Pos(OnBitChar, BPCParam) <> 0 ) OR
  1166.      ( OnBitChar = '=' ) OR
  1167.      ( IsNum(OnBitChar) ) Then
  1168.     Exit;
  1169.  
  1170.   If ( Pos(OffBitChar, BPCParam) <> 0 ) OR
  1171.      ( OffBitChar = '=' ) OR
  1172.      ( IsNum(OffBitChar) ) Then
  1173.     Exit;
  1174.  
  1175.   {----------------}
  1176.   { Blockread file }
  1177.   {----------------}
  1178.  
  1179.   If NOT FileExist(Filename) Then
  1180.     Exit;
  1181.  
  1182.   Assign(F, Filename);
  1183.   Reset(F, 1);
  1184.   BufSize := FileSize(F);
  1185.   GetMem( Buf, BufSize );
  1186.   BlockRead( F, Buf^, BufSize );
  1187.   Close( F );
  1188.  
  1189.   {---------------}
  1190.   { Get ScanLines }
  1191.   {---------------}
  1192.  
  1193.   BPCPos := PosBufNoCase( BPCParam, Buf^, BufSize );
  1194.   If (BPCPos = -1) Then
  1195.     FontSet.ScanLines := 16
  1196.   Else
  1197.   BEGIN
  1198.  
  1199.     P := PtrAdd(Buf, BPCPos);
  1200.     S[0] := #0;
  1201.     S := ArrayToStr( P^, Byte(BPCParam[0])+3 );
  1202.     Param := GetParamData(S);
  1203.     If NOT IsNum(Param[2]) Then
  1204.       Param[0] := #1;
  1205.     FontSet.ScanLines := StrToInt(Param);
  1206.  
  1207.   END;
  1208.  
  1209.   {-----------------}
  1210.   { Create fontmaps }
  1211.   {-----------------}
  1212.  
  1213.   OnFont := StartChar;
  1214.   OnLine := 1;
  1215.   OnBit  := Pred(FontSet.Width);
  1216.   BufPos := 0;
  1217.  
  1218.   While ( BufPos <= BufSize ) AND
  1219.         ( (OnFont <= 255) OR
  1220.           (OnFont <= EndChar) ) Do
  1221.   BEGIN
  1222.  
  1223.     If (Buf^[BufPos] = OnBitChar) Then
  1224.     BEGIN
  1225.  
  1226.       TByteArray(FontSet.Table^)[(OnFont*FontSet.ScanLines)+OnLine] :=
  1227.         TByteArray(FontSet.Table^)[(OnFont*FontSet.ScanLines)+OnLine] OR CBitMapW[OnBit];
  1228.       IncFontPos;
  1229.  
  1230.     END
  1231.     Else
  1232.     If (Buf^[BufPos] = OffBitChar) Then
  1233.     BEGIN         { TByteArrayZ }
  1234.  
  1235.       TByteArray(FontSet.Table^)[(OnFont*FontSet.ScanLines)+OnLine] :=
  1236.         TByteArray(FontSet.Table^)[(OnFont*FontSet.ScanLines)+OnLine] AND NOT CBitMapW[OnBit];
  1237.       IncFontPos;
  1238.  
  1239.     END;
  1240.  
  1241.     Inc(BufPos);
  1242.  
  1243.   END;
  1244.  
  1245.   FreeMem( Buf, BufSize );
  1246.  
  1247. END;
  1248.  
  1249. {────────────────────────────────────────────────────────────────────────────}
  1250.  
  1251. (*-
  1252.  
  1253. [FUNCTION]
  1254.  
  1255. Procedure VFontPutText(           Filename       : PathStr;
  1256.                                   StartChar      : BYTE;
  1257.                                   EndChar        : BYTE;
  1258.                                   OnBitChar      : CHAR;
  1259.                                   OffBitChar     : CHAR;
  1260.                                   FontSet        : TFontSet     );
  1261.  
  1262. [PARAMETERS]
  1263.  
  1264. Filename    A valid path and filename to create.
  1265. StartChar   Starting character to "overwrite" (0..255).
  1266. EndChar     Ending character to "overwrite" (0..255).
  1267. OnBitChar   Character in textfile to consider as an On-Bit in a font.
  1268. OffBitChar  Character in textfile to consider as an Off-Bit in a font.
  1269. FontSet     Fontlist information record.
  1270.  
  1271. [RETURNS]
  1272.  
  1273. <none>
  1274.  
  1275. [DESCRIPTION]
  1276.  
  1277. Creates a textfile with the specified range of the FontSet.  The layout
  1278. overwrite any fonts within that region.
  1279.  
  1280. [SEE-ALSO]
  1281.  
  1282. [EXAMPLE]
  1283.  
  1284. -*)
  1285.  
  1286. Procedure VFontPutText(           Filename       : PathStr;
  1287.                                   StartChar      : BYTE;
  1288.                                   EndChar        : BYTE;
  1289.                                   OnBitChar      : CHAR;
  1290.                                   OffBitChar     : CHAR;
  1291.                                   FontSet        : TFontSet     );
  1292.  
  1293. Var
  1294.  
  1295.   T       : TEXT;
  1296.   Z1,
  1297.   Z2,
  1298.   Z4      : INTEGER;
  1299.   S       : STRING;
  1300.  
  1301. BEGIN
  1302.  
  1303.   {-----------------------------------}
  1304.   { Check for reserved bit characters }
  1305.   {-----------------------------------}
  1306.  
  1307.   If ( Pos(OnBitChar, BPCParam) <> 0 ) OR
  1308.      ( OnBitChar = '=' ) OR
  1309.      ( IsNum(OnBitChar) ) Then
  1310.     Exit;
  1311.  
  1312.   If ( Pos(OffBitChar, BPCParam) <> 0 ) OR
  1313.      ( OffBitChar = '=' ) OR
  1314.      ( IsNum(OffBitChar) ) Then
  1315.     Exit;
  1316.  
  1317.   {------------}
  1318.   { Setup file }
  1319.   {------------}
  1320.  
  1321.   Assign(T, Filename);
  1322.   ReWrite(T);
  1323.  
  1324.   {----------------}
  1325.   { Write fontmaps }
  1326.   {----------------}
  1327.  
  1328.   WriteLn( T, BPCParam + '=' + IntToStr(FontSet.ScanLines) );
  1329.  
  1330.   For Z1 := StartChar to EndChar Do
  1331.   BEGIN
  1332.  
  1333.     WriteLn(T, '_', Pad('/'+IntToStr(Z1)+'\', 7, OnRight, '_') );
  1334.  
  1335.     For Z2 := 1 to FontSet.ScanLines Do
  1336.     BEGIN
  1337.  
  1338.       S[0] := #0;
  1339.  
  1340.       For Z4 := Pred(FontSet.Width) downto 0 Do
  1341.       BEGIN
  1342.  
  1343.         If (TByteArray(FontSet.Table^)[(Z1*FontSet.ScanLines)+Z2] AND CBitMapW[Z4]) <> 0 Then
  1344.           S := S + OnBitChar
  1345.         Else
  1346.           S := S + OffBitChar;
  1347.  
  1348.       END;
  1349.  
  1350.       Write(T, S);
  1351.  
  1352.       If (Z2 = 1) Then
  1353.         WriteLn(T, '\')
  1354.       Else
  1355.         WriteLn(T, '│');
  1356.  
  1357.     END;
  1358.  
  1359.   END;
  1360.  
  1361.   Flush(T);
  1362.   Close(T);
  1363.  
  1364. END;
  1365.  
  1366.  
  1367. {────────────────────────────────────────────────────────────────────────────}
  1368.  
  1369. (*-
  1370.  
  1371. [FUNCTION]
  1372.  
  1373. Procedure VFontMakePascal(        Filename       : PathStr;
  1374.                                   FontSet        : TFontSet;
  1375.                                   StartChar      : BYTE;
  1376.                                   EndChar        : WORD         );
  1377.  
  1378. [PARAMETERS]
  1379.  
  1380. [RETURNS]
  1381.  
  1382. [DESCRIPTION]
  1383.  
  1384. [SEE-ALSO]
  1385.  
  1386. [EXAMPLE]
  1387.  
  1388. -*)
  1389.  
  1390. Procedure VFontMakePascal(        Filename       : PathStr;
  1391.                                   FontSet        : TFontSet;
  1392.                                   StartChar      : BYTE;
  1393.                                   EndChar        : WORD         );
  1394.  
  1395. Var
  1396.  
  1397.   T      : TEXT;
  1398.   OnFont : WORD;
  1399.   OnSL   : WORD;
  1400.  
  1401. BEGIN
  1402.  
  1403.   Assign ( T, MaskWildcards(Filename, '*.PAS') );
  1404.   Rewrite( T );
  1405.  
  1406.   WriteLn( T, 'Const' );
  1407.   WriteLn( T, '     Fonts : Array[0..',
  1408.            ( ( ( EndChar - StartChar ) + 1 ) * 16 ) - 1, '] of BYTE =' );
  1409.  
  1410.   Write  ( T, '               ( ' );
  1411.  
  1412.   For OnFont := StartChar to EndChar Do
  1413.   BEGIN
  1414.  
  1415.     For OnSL := 1 to FontSet.ScanLines Do
  1416.     BEGIN
  1417.  
  1418.       If OnSL = 9 Then
  1419.       BEGIN
  1420.  
  1421.         WriteLn( T );
  1422.         Write  ( T, '                 ' );
  1423.  
  1424.       END;
  1425.  
  1426.       Write(T, '$',
  1427.         ByteToHex(TByteArray(FontSet.Table^)[(OnFont*FontSet.ScanLines)+OnSL]) );
  1428.  
  1429.       If ( OnFont <> EndChar ) AND ( OnSL <> FontSet.ScanLines ) Then
  1430.         Write( T, ', ' );
  1431.  
  1432.     END;
  1433.  
  1434.     WriteLn( T );
  1435.     Write  ( T, '                 ' );
  1436.  
  1437.   END;
  1438.  
  1439.   WriteLn( T, ' );' );
  1440.  
  1441.   Close( T );
  1442.  
  1443. END;
  1444.  
  1445. {────────────────────────────────────────────────────────────────────────────}
  1446.  
  1447. (*-
  1448.  
  1449. [FUNCTION]
  1450.  
  1451. Procedure VFontROM8x16Load;
  1452.  
  1453. [PARAMETERS]
  1454.  
  1455. [RETURNS]
  1456.  
  1457. [DESCRIPTION]
  1458.  
  1459. [SEE-ALSO]
  1460.  
  1461. [EXAMPLE]
  1462.  
  1463. -*)
  1464.  
  1465. Procedure VFontROM8x16Load;
  1466.  
  1467. {$IFNDEF OS2}
  1468.  
  1469. Assembler;
  1470. ASM
  1471.  
  1472.   MOV AH, $11
  1473.   MOV AL, $04
  1474.   MOV BL, 0
  1475.  
  1476.   INT $10
  1477.  
  1478. END;
  1479.  
  1480. {$ELSE}
  1481.  
  1482. BEGIN
  1483.  
  1484.   {!^!}
  1485.  
  1486. END;
  1487.  
  1488. {$ENDIF}
  1489.  
  1490.  
  1491. {────────────────────────────────────────────────────────────────────────────}
  1492.  
  1493. (*-
  1494.  
  1495. [FUNCTION]
  1496.  
  1497. Procedure VFontROM8x14Load;
  1498.  
  1499. [PARAMETERS]
  1500.  
  1501. [RETURNS]
  1502.  
  1503. [DESCRIPTION]
  1504.  
  1505. [SEE-ALSO]
  1506.  
  1507. [EXAMPLE]
  1508.  
  1509. -*)
  1510.  
  1511. Procedure VFontROM8x14Load;
  1512.  
  1513. {$IFNDEF OS2}
  1514.  
  1515. Assembler;
  1516. ASM
  1517.  
  1518.   MOV  AH, $11
  1519.   MOV  AL, $01
  1520.   MOV  BL, 0
  1521.  
  1522.   INT  $10
  1523.  
  1524. END;
  1525.  
  1526. {$ELSE}
  1527.  
  1528. BEGIN
  1529.  
  1530.   {!^!}
  1531.  
  1532. END;
  1533.  
  1534. {$ENDIF}
  1535.  
  1536.  
  1537. {────────────────────────────────────────────────────────────────────────────}
  1538.  
  1539. (*-
  1540.  
  1541. [FUNCTION]
  1542.  
  1543. Procedure VFontROM8x8Load;
  1544.  
  1545. [PARAMETERS]
  1546.  
  1547. [RETURNS]
  1548.  
  1549. [DESCRIPTION]
  1550.  
  1551. [SEE-ALSO]
  1552.  
  1553. [EXAMPLE]
  1554.  
  1555. -*)
  1556.  
  1557. Procedure VFontROM8x8Load;
  1558.  
  1559. {$IFNDEF OS2}
  1560.  
  1561. Assembler;
  1562. ASM
  1563.  
  1564.   MOV  AH, $11
  1565.   MOV  AL, $02
  1566.   MOV  BL, 0
  1567.  
  1568.   INT  $10
  1569.  
  1570. END;
  1571.  
  1572. {$ELSE}
  1573.  
  1574. BEGIN
  1575.  
  1576.   {!^!}
  1577.  
  1578. END;
  1579.  
  1580. {$ENDIF}
  1581.  
  1582.  
  1583. {────────────────────────────────────────────────────────────────────────────}
  1584.  
  1585. (*-
  1586.  
  1587. [FUNCTION]
  1588.  
  1589. Procedure VFontDefaultLoad;
  1590.  
  1591. [PARAMETERS]
  1592.  
  1593. [RETURNS]
  1594.  
  1595. [DESCRIPTION]
  1596.  
  1597. [SEE-ALSO]
  1598.  
  1599. [EXAMPLE]
  1600.  
  1601. -*)
  1602.  
  1603. Procedure VFontDefaultLoad;
  1604.  
  1605. BEGIN
  1606.  
  1607. {
  1608.  
  1609.   If PrimaryConsoleIsVGA Then
  1610.   BEGIN
  1611.  
  1612.     If Rows50 Then
  1613.       VFontRom8x8Load
  1614.     Else
  1615.       VFontRom8x16Load;
  1616.  
  1617.   END
  1618.   ELSE
  1619.   If PrimaryConsoleisEGA Then
  1620.   BEGIN
  1621.  
  1622.     If Rows43 Then
  1623.       VFonrRom8x8Load
  1624.     Else
  1625.       VFontRom8x14Load;
  1626.  
  1627.   END;
  1628.  
  1629. }
  1630.  
  1631. END;
  1632.  
  1633. {────────────────────────────────────────────────────────────────────────────}
  1634.  
  1635. (*-
  1636.  
  1637. [FUNCTION]
  1638.  
  1639. Procedure VFontVGAWidthSet(       CharWidth      : BYTE         );
  1640.  
  1641. [PARAMETERS]
  1642.  
  1643. [RETURNS]
  1644.  
  1645. [DESCRIPTION]
  1646.  
  1647. [SEE-ALSO]
  1648.  
  1649. [EXAMPLE]
  1650.  
  1651. -*)
  1652.  
  1653. Procedure VFontVGAWidthSet(       CharWidth      : BYTE     );
  1654.  
  1655. {$IFNDEF OS2}
  1656.  
  1657. Var
  1658.  
  1659.   R : REGISTERS;
  1660.   B : BYTE;
  1661.  
  1662. BEGIN
  1663.  
  1664.   If CharWidth in [8..9] Then
  1665.   BEGIN
  1666.  
  1667.     Case CharWidth Of
  1668.  
  1669.       8 :
  1670.       BEGIN
  1671.  
  1672.         B    := (Port[ $3CC ] and NOT(4+8));
  1673.         R.BX := $0001;
  1674.  
  1675.       END;
  1676.  
  1677.       9 :
  1678.       BEGIN
  1679.  
  1680.         B    := (Port[ $3CC ] and NOT(4+8)) or 4;
  1681.         R.BX := $0800;
  1682.  
  1683.       END;
  1684.  
  1685.     END;
  1686.  
  1687.     Port[ $3C2 ] := B;
  1688.  
  1689.     ASM CLI; END;
  1690.  
  1691.     PortW[ $3C4 ] := $0100;
  1692.     PortW[ $3C4 ] := $01 + R.BL SHL 8;
  1693.     PortW[ $3C4 ] := $0300;
  1694.  
  1695.     ASM STI; END;
  1696.  
  1697.     R.AX := $1000;
  1698.     R.BL := $13;
  1699.     R.ES := $0;
  1700.     R.DS := $0;
  1701.  
  1702.     Intr( $10, R );
  1703.  
  1704.   END;
  1705.  
  1706. END;
  1707.  
  1708. {$ELSE}
  1709.  
  1710. BEGIN
  1711.  
  1712.  {!^!}
  1713.  
  1714. END;
  1715.  
  1716. {$ENDIF}
  1717.  
  1718. {────────────────────────────────────────────────────────────────────────────}
  1719.  
  1720. (*-
  1721.  
  1722. [FUNCTION]
  1723.  
  1724. Procedure VFontSetScale(          Source         : TFontSet;
  1725.                                   StartChar      : BYTE;
  1726.                                   EndChar        : WORD;
  1727.                               Var Target         : TFontSet     );
  1728.  
  1729. [PARAMETERS]
  1730.  
  1731. [RETURNS]
  1732.  
  1733. [DESCRIPTION]
  1734.  
  1735. [SEE-ALSO]
  1736.  
  1737. [EXAMPLE]
  1738.  
  1739. -*)
  1740.  
  1741. Procedure VFontSetScale(          Source         : TFontSet;
  1742.                                   StartChar      : BYTE;
  1743.                                   EndChar        : WORD;
  1744.                               Var Target         : TFontSet     );
  1745.  
  1746. Var
  1747.  
  1748.   P1     : PByteArray; { Source table }
  1749.   P2     : PByteArray; { Target table }
  1750.  
  1751.   P1Loc  : WORD;       { Base location of source table }
  1752.   P2Loc  : WORD;       { Base location of target table }
  1753.  
  1754.   OnFont : BYTE;       { Current Font # (ASCII value) }
  1755.   OnSL   : BYTE;       { Current Scanline (element) }
  1756.   OnBit  : BYTE;       { Current Bit (in element) }
  1757.  
  1758.   SS     : BYTE;       { Source Scanlines }
  1759.   TS     : BYTE;       { Target Scanlines }
  1760.   SW     : BYTE;       { Source Width }
  1761.   TW     : BYTE;       { Target Width }
  1762.  
  1763.   L1     : BYTE;
  1764.  
  1765.   {────────────────────────────────────────────────────────────────────────}
  1766.  
  1767.   Function Scale( Var Pos, Max, NewMax : BYTE ) : BYTE;
  1768.   Var
  1769.  
  1770.     R : REAL;
  1771.  
  1772.   BEGIN
  1773.  
  1774.     R := (Pos * NewMax) / Max;
  1775.  
  1776.     Scale := Round( R );
  1777.  
  1778.   END;
  1779.  
  1780.   {────────────────────────────────────────────────────────────────────────}
  1781.  
  1782. BEGIN
  1783.  
  1784.   { Setup code macros }
  1785.  
  1786.   P1 := Source.Table;
  1787.   P2 := Target.Table;
  1788.   SS := Source.ScanLines;
  1789.   TS := Target.ScanLines;
  1790.   SW := Source.Width;
  1791.   TW := Target.Width;
  1792.  
  1793.   FillChar( P2^[StartChar * TS], (EndChar - StartChar) * TS, 0 );
  1794.  
  1795.   For OnFont := StartChar to EndChar Do
  1796.   BEGIN
  1797.  
  1798.     { setup locators }
  1799.  
  1800.     P1Loc := (SS * OnFont);
  1801.     P2Loc := (TS * OnFont);
  1802.  
  1803.     { erase target font }
  1804.  
  1805.     { now check scanlines }
  1806.  
  1807.     For OnSL := 1 to SS Do
  1808.     BEGIN
  1809.  
  1810.       { check Width }
  1811.  
  1812.       For OnBit := 0 to Pred(SW) Do
  1813.       BEGIN
  1814.  
  1815.         If (P1^[P1Loc + OnSL] AND CBitMapW[OnBit] <> 0) Then
  1816.         BEGIN
  1817.  
  1818.           L1 := Scale(OnSL, SS, TS);
  1819.  
  1820.         { turn bit on }
  1821.  
  1822.           P2^[P2Loc + L1] := P2^[P2Loc + L1] OR
  1823.             CBitMapW[Scale(OnBit, SW, TW)];
  1824.  
  1825.         END;
  1826.  
  1827.       END;
  1828.  
  1829.     END;
  1830.  
  1831.   END;
  1832.  
  1833. END;
  1834.  
  1835. {────────────────────────────────────────────────────────────────────────────}
  1836.  
  1837. (*-
  1838.  
  1839. [FUNCTION]
  1840.  
  1841. Procedure VFontAltPut(            Index          : BYTE;
  1842.                                   Count          : WORD;
  1843.                                   ScanLines      : BYTE;
  1844.                                   Table          : POINTER      );
  1845.  
  1846. [PARAMETERS]
  1847.  
  1848. [RETURNS]
  1849.  
  1850. [DESCRIPTION]
  1851.  
  1852. [SEE-ALSO]
  1853.  
  1854. [EXAMPLE]
  1855.  
  1856. -*)
  1857.  
  1858. Procedure VFontAltPut(            Index          : BYTE;
  1859.                                   Count          : WORD;
  1860.                                   ScanLines      : BYTE;
  1861.                                   Table          : POINTER      );
  1862. {$IFNDEF OS2}
  1863.  
  1864. BEGIN
  1865.  
  1866.   ASM
  1867.  
  1868.    { Set alternate font map block }
  1869.  
  1870.     MOV  AX, 1100h
  1871.     MOV  BH, ScanLines
  1872.     MOV  BL, 1
  1873.     MOV  CX, Word( Count )
  1874.     MOV  DX, Word( Index )
  1875.     MOV  ES, Word( Table + 2 )
  1876.     PUSH BP
  1877.     MOV  BP, Word( Table )
  1878.     INT  10h
  1879.     POP  BP
  1880.  
  1881.    { Set intensity bit and palette register }
  1882.  
  1883.  
  1884.     MOV  AX, 1103h
  1885.     MOV  BL, 00000100b
  1886.     INT  10h
  1887.  
  1888.     MOV  AX, 1000h
  1889.     MOV  BX, 0712h
  1890.     INT  10h
  1891.  
  1892.   END;
  1893.  
  1894. END;
  1895.  
  1896. {$ELSE}
  1897.  
  1898. BEGIN
  1899.  
  1900.   {!^!}
  1901.  
  1902. END;
  1903.  
  1904. {$ENDIF}
  1905.  
  1906.  
  1907. {────────────────────────────────────────────────────────────────────────────}
  1908.  
  1909. (*-
  1910.  
  1911. [FUNCTION]
  1912.  
  1913. Procedure VFontAltSetPut(         FontSet        : TFontSet     );
  1914.  
  1915. [PARAMETERS]
  1916.  
  1917. [RETURNS]
  1918.  
  1919. [DESCRIPTION]
  1920.  
  1921. [SEE-ALSO]
  1922.  
  1923. [EXAMPLE]
  1924.  
  1925. -*)
  1926.  
  1927. Procedure VFontAltSetPut(         FontSet        : TFontSet     );
  1928.  
  1929. BEGIN
  1930.  
  1931.   VFontAltPut( 0, 256, FontSet.ScanLines, FontSet.Table );
  1932.  
  1933. END;
  1934.  
  1935. {────────────────────────────────────────────────────────────────────────────}
  1936.  
  1937. Function  GetCGAPixelMap( Ch : CHAR ) : PCharPixelMap;
  1938. BEGIN
  1939.  
  1940.   If Ch > #127 Then
  1941.     GetCGAPixelMap := NIL
  1942.   Else
  1943.     GetCGAPixelMap := Ptr( $FFA6, $E + ( Byte(Ch) SHL 3 ) );
  1944.  
  1945. END;
  1946.  
  1947. {────────────────────────────────────────────────────────────────────────────}
  1948. {────────────────────────────────────────────────────────────────────────────}
  1949. {────────────────────────────────────────────────────────────────────────────}
  1950.  
  1951. BEGIN
  1952. END.
  1953.